//	COPYRIGHT (C) 1981 BY BOARD OF TRUSTEES,
//	LELAND STANFORD JUNIOR UNIVERSITY

//APRIL 25, 1978
//BCPL-CONGEN, WRITTEN BY RAY CARHART.  THIS IS THE MAIN FILE FOR
//THE "PRUNE" SUBMODULE.  IN IT, GLOBAL VARIABLES ARE DEFINED, DATA
//IS INPUT AND THE GRAPH MATCHER IS CALLED.
GET "BCPLIB.GET"
GET "MYLIB.GET"
STATIC $( VECSPACE = VEC 5000; STACK = VEC 1000; STACKPTR = 0 $);
LET DOSTUFF() BE
$( STATIC $( NTYPES=NIL; TYPENAME=NIL; TYPEVALENCE=NIL; ATTYPE=NIL;
             HMIN=NIL; NNODES=NIL; U=NIL; GSTART=1; GSTOP=NIL;
             TYPENUM = NIL; PATSTART=NIL; PATSTOP=NIL; CTABLE=NIL;
             CTSTART=NIL; CTSTOP=NIL; HMAX = NIL; NUMHS = NIL;
             DOTS = NIL; MAPPEDTO = NIL; NLNODES = NIL; LMINS = NIL;
             LMAXS = NIL; LNODE= NIL; PTFLAG = NIL; NUMISBS = NIL;
             TYPEISBMIN = NIL; TYPEISBMAX = NIL; ARTYPE = NIL $);
STATIC $( CTPTR = 1; NBR = NIL; ATI = NIL $);
MANIFEST $( P2WDSZ = 5; R2WDSZ = 32 $);
STATIC $( NSTRUCS = NIL; PATREC = NIL; INFILE = NIL; OUTFILE = NIL;
          INSOURCE = NIL; STRUCNUMBER = NIL; MINSNUM = NIL; MAXSNUM = NIL $);
STATIC $( NUMPAT = NIL; PATRECS = NIL; PATMINS = NIL; PATMAXS = NIL;
          PATNNDS = NIL; NPATNODES = NIL; KEEPIT = NIL $);
STATIC $( PTRTOP = NIL $);
STATIC $( NATH = NIL; ATHSTART = NIL; ATTYPEH = NIL $);
STATIC $( STOPAFTER = NIL; STOPLAB = NIL $);
STATIC $( EOFSTR = NIL; PARTIAL = NIL $)	// ADDED 5/81 ALF 
GET "SETFNS.BCL"
GET "MAKPAT.BCL"
GET "GMATCH.BCL"
GET "PATSIN.BCL"
GET "GETISB.BCL"
GET "RDCYCC.BCL"
GET "CYCLES.BCL"
GET "SEGFNS.BCL"

LET FETCHSTRUC() = VALOF
 $( STATIC $( CTPTR = NIL; NBR = NIL; NDIX = NIL; ONBR = NIL;
              NDOT = NIL; NISB = NIL; NH = NIL; SKIP = NIL $);
 STRUCNUMBER:=0;
 INPUT:=INFILE;
 NEXTSTRUC:
 SKIP:=FALSE;
 NBR:=[INCH()+80]REM 128;
 IF NBR=127 DO $( INPUT:=INSOURCE; RESULTIS FALSE $);
 IF NBR=126 DO $( STRUCNUMBER:=INNO(); INCH(); NBR:=[INCH()+80]REM 128 $);
 CTPTR:=1;
 NDIX:=0;
 WHILE NBR NE 127 DO
  $(
  NDIX+:=1;
  CTSTART!NDIX:=CTPTR;
  ARTYPE!NDIX:=1;
  ONBR:=0;
  NISB:=0;
  NDOT:=0;
  UNTIL NBR=0 DO
   $(
   TEST NBR=NDIX THEN NISB+:=1
   OR
    TEST NBR=125 THEN ARTYPE!NDIX:=2
    OR
     $(
     IF NBR=ONBR DO NDOT+:=1;
     ONBR:=NBR;
     CTABLE!CTPTR:=NBR;
     CTPTR+:=1
     $);
   NBR:=[INCH()+80]REM 128
   $);
  CTSTOP!NDIX:=CTPTR-1;
  NH:=TYPEVALENCE![ATTYPE!NDIX]-CTPTR+CTSTART!NDIX-NISB;
  IF NH<0 DO SKIP:=TRUE;
  NUMHS!NDIX:=NH;
  NUMISBS!NDIX:=NISB>>1;
  DOTS!NDIX:=NDOT;
  NBR:=[INCH()+80]REM 128
  $);
 IF SKIP DO $( OUTCHP('?'); GOTO NEXTSTRUC $);
 INPUT:=INSOURCE;
 RESULTIS TRUE
 $);

LET PUTSTRUC() BE
 $( STATIC $( NISB = NIL $);
 OUTPUT:=OUTFILE;
 NSTRUCS:=NSTRUCS+1;				//5/81 ALF
 IF STRUCNUMBER>0 DO $( OUTCH(46); OUTNOS(STRUCNUMBER) $);
 FOR I=1 TO GSTOP DO
  $(
  NISB:=NUMISBS!I<<1;
  IF ARTYPE!I=2 DO OUTCH([125+48]REM 128);
  WHILE NISB>0 DO $( NISB-:=1; OUTCH([I+48]REM 128) $);
  FOR J=CTSTART!I TO CTSTOP!I DO OUTCH([[CTABLE!J]+48]REM 128);
  OUTCH(48)
  $);
 OUTCH(47);
 OUTPUT:=TTY;
 OUTCHP('.');					//5/81 ALF
 IF NSTRUCS=STOPAFTER DO JUMP(STOPLAB)
 $);

INFILE:=FINDFILE("DSK",STRFILENAME(),CGEXT);
RETPART:=0
IF FILEEXISTS(SC1FILENAME(),CGEXT) DO
 $( INPUT:=FINDFILE("DSK",SC1FILENAME(),CGEXT);
    READRETURN()
  $)
INSOURCE:=INPUT;
OUTSIF("NUMBER OF ATOM TYPES:"); NTYPES:=INNO();
TYPENAME:=NEWVEC(NTYPES); TYPEVALENCE:=NEWVEC(NTYPES);
TYPEISBMIN:=NEWVEC(NTYPES); TYPEISBMAX:=NEWVEC(NTYPES);
TYPENAME!0:="**"; TYPENUM:=NEWVEC(NTYPES);
ATHSTART:=NEWVEC(NTYPES); NATH:=0;
OUTSIF("NAMES AND VALENCES:");
FOR I=1 TO NTYPES DO
 $(
 TYPENUM!I:=0;
 TYPENAME!I:=COPYS(INS());
 TYPEVALENCE!I:=INNO();
 ATHSTART!I:=NATH;
 NATH+:=TYPEVALENCE!I+1
 $);
OUTSIF("NUMBER OF PATTERNS:");NUMPAT:=INNO();
PATNNDS:=NEWVEC(NUMPAT);
OUTSIF("NUMBER OF NODES FOR EACH PATTERN:"); NNODES:=0;
FOR I=1 TO NUMPAT DO $( PATNNDS!I:=INNO(); NNODES+:=PATNNDS!I $);
PATRECS:=NEWVEC(NUMPAT);
PATMINS:=NEWVEC(NUMPAT); PATMAXS:=NEWVEC(NUMPAT);
INPUT:=INFILE;
GSTOP:=INNO();
NNODES+:=GSTOP;
ATTYPE:=NEWVEC(NNODES); ATTYPEH:=NEWVEC(NNODES); CTSTART:=NEWVEC(NNODES);
CTSTOP:=NEWVEC(NNODES); DOTS:=NEWVEC(NNODES);
HMIN:=NEWVEC(NNODES); NUMHS:=HMIN; HMAX:=NEWVEC(NNODES-GSTOP)-GSTOP;
LMINS:=NEWVEC(NNODES-GSTOP)-GSTOP; LMAXS:=NEWVEC(NNODES-GSTOP)-GSTOP;
NUMISBS:=NEWVEC(GSTOP);
FOR I=GSTOP+1 TO NNODES DO $( LMINS!I:=0; LMAXS!I:=0 $);
MAPPEDTO:=NEWVEC(NNODES); FOR I=1 TO NNODES DO MAPPEDTO!I:=0;
ARTYPE:=NEWVEC(NNODES); FOR I=1 TO NNODES DO ARTYPE!I:=1;
U:=INNO();
CTPTR:=1+2*[U+GSTOP-1];
FOR I=1 TO GSTOP DO
 $(
 ATI:=FINDTYPE(INS());
 ATTYPE!I:=ATI;
 ATTYPEH!I:=ATHSTART!ATI;
 TYPENUM!ATI+:=1
 $);
INPUT:=INSOURCE;
PATSTOP:=GSTOP;
CTABLE:=STACK;
READPATS();
CTPTR-:=1;
GETISBRANGES("NUMBER OF ATOM TYPES FOR WHICH ISB RANGE IS TO BE TESTED:",
              0,100);
READCYCCONSTR();
OUTSIF("STOPAFTER (NON-POSITIVE ENTRY MEANS PRODUCE ALL STRUCTURES):");
STOPAFTER:=INNO();
UNLESS INPUT=TTY DO
 $(
 ENDREAD(INPUT);
 DELETEFILE(SC1FILENAME(),CGEXT);
 INPUT:=TTY
 $);
OUTFILE:=CREATEFILE("DSK",SC1FILENAME(),CGEXT);
OUTPUT:=OUTFILE;
OUTNOS(GSTOP);
OUTNOS(U);
FOR I=1 TO GSTOP DO $( OUTS(TYPENAME![ATTYPE!I]); SPACES(1) $);
OUTPUT:=TTY;

CTABLE:=NEWVEC(CTPTR);
WHILE CTPTR>0 DO $( CTABLE!CTPTR:=STACK!CTPTR; CTPTR-:=1 $);

MINSNUM:=0;
NSTRUCS:=0;
STOPLAB:=LABEL(WRAPUP);
WHILE FETCHSTRUC() DO
 $(
 KEEPIT:=TRUE;
 FOR I=GSTART TO GSTOP DO
  $(
  ATI:=ATTYPE!I;
  UNLESS TYPEISBMIN!ATI LE NUMISBS!I LE TYPEISBMAX!ATI DO
   $( KEEPIT:=FALSE; BREAK $)
  $);
 IF KEEPIT DO
  IF ANYRINGTESTS DO KEEPIT:=CYCSOK(GSTART,GSTOP,CYCMINS,CYCMAXS,DIAMLISTS);
 IF KEEPIT DO KEEPIT:=PATTEST(GSTART,GSTOP);
 TEST KEEPIT THEN
  $(
  IF MINSNUM=0 DO MINSNUM:=STRUCNUMBER;
  MAXSNUM:=STRUCNUMBER;
  PUTSTRUC();
//  NSTRUCS+:=1;	 		REMOVED 5/81 BY ALF
//  OUTCHP('.')
  $)
 OR OUTCHP('**');

 $);
WRAPUP:

// CHANGE 5/81 BY ALF
EOFSTR := TRUE;			// ASSUME ALL THE WAY THROUGH STR FILE
IF NSTRUCS=STOPAFTER DO		// IF = , POSSIBLE PARTIAL STRUCTURE LIST
  $( INPUT := INFILE;
     EOFSTR := NOT FETCHSTRUC() //NO STRUCTURES LEFT => EOF
  $)
// END OF CHANGE BY ALF

ENDREAD(INFILE);
OUTPUT:=OUTFILE;
OUTCH(47);
OUTPUT:=TTY;
ENDWRITE(OUTFILE);
NEWLINE(1);
TEST NSTRUCS=0 THEN
 $(
 DELETEFILE(SC1FILENAME(),CGEXT);
 OUTS("NO STRUCTURES SURVIVED PRUNING*C*L");
 OUTS("THE ORIGINAL LIST HAS BEEN RESTORED*C*L")
 $)
OR
 $(
 OUTPUT:=CREATEFILE("DSK",SC2FILENAME(),CGEXT);
 INPUT:=FINDFILE("DSK",TOPFILENAME(),CGEXT);
 COPYSEGSTO(CHUNKSEP,SSHEADSTR,TRUE);
 PARTIAL := FALSE;					//CHANGE 5/81 ALF
 INNO(); IF INCH()=' ' DO PARTIAL := TRUE;		//CHANGE 5/81 ALF
 TEST ((PARTIAL) \/ (NOT EOFSTR)) THEN			//CHANGE 5/81 ALF
  $( OUTNOS(NSTRUCS); OUTS("PARTIAL*C*L") $)
 OR OUTNOL(NSTRUCS);
 OUTNOS(MINSNUM); OUTNOL(MAXSNUM); OUTNOS(U)
 FOR I=1 TO NTYPES DO
  IF [TYPENUM!I]>0 DO $( OUTS(TYPENAME!I); SPACES(1); OUTNOS(TYPENUM!I) $);
 NEWLINE(1);
 SKIPSEG(CHUNKSEP);
 OUTCH(CHUNKSEP);
 COPYTOEND();
 ENDREAD(INPUT);
 INPUT:=TTY;
 ENDWRITE(OUTPUT);
 OUTPUT:=TTY;
 INTERRUPTABLE(FALSE);
 FILEREPLACE(STRFILENAME(),CGEXT,SC1FILENAME(),CGEXT);
 FILEREPLACE(TOPFILENAME(),CGEXT,SC2FILENAME(),CGEXT);
 OUTNOS(NSTRUCS);
 OUTS("STRUCTURE");
 IF NSTRUCS>1 DO OUTCH('S');
 OUTS(" SURVIVED PRUNING*C*L");
 IF ((PARTIAL) \/ (NOT EOFSTR)) DO			//CHANGE 5/81 ALF
  OUTS("!!!!! THIS IS ONLY A PARTIAL STRUCTURE LIST !!!!!*C*L");
 INTERRUPTABLE(TRUE)
 $);
TEST RETPART=0 THEN FINISH OR EXECUTERETURN()
$);
LET START() BE
 $(
// ![#124]:=TOPORSTOP;
 INITIALISEIO(VECSPACE,5000);
 OUTPUT:=TTY;
 INPUT:=TTY;
 RECINIT();
 DOSTUFF()
 $)
